﻿Imports Microsoft.Win32

' OpenVPN Tunnel Manager & Tunnel Abstraction Class 
' (c) 2012 chris burri @ Burri IT Systems

Public Class OpenVPNTunMgr

#Region "Declares"


#End Region

#Region "Private Objects and Vars"
    ' configuration object
    Private WithEvents Config As OpenVPNConfiguration
    ' tunnels list
    Private _Tunnels As New List(Of Tunnel)
#End Region

#Region "Public Interface"
    Public Sub Start()
        Call StartTunnels()
    End Sub

    Public Sub [Stop]()
        Call StopTunnels()
    End Sub

    Public ReadOnly Property ComponentVersion() As String
        Get
            Dim VersionInfo As Version = System.Reflection.Assembly.GetExecutingAssembly.GetName.Version
            Return VersionInfo.Major & "." & VersionInfo.Minor & "." & VersionInfo.Build & "." & VersionInfo.Revision
        End Get
    End Property
#End Region

#Region "Control Functions"
    Public Sub StartTunnels()

        Dbg("Starting Tunnels...")
        ' stop all running tunnels
        Call StopTunnels()

        ' kill stale openvpn.exe procs
        KillAll("openvpn")

        ' set new list
        _Tunnels = New List(Of Tunnel)

        Config = New OpenVPNConfiguration
        Config.ReadConfiguration()

    End Sub

    Public Sub StopTunnels()

        Dbg("Stopping Tunnels...")
        ' stop all tunnels
        For Each tun As Tunnel In _Tunnels
            tun.Stop()
        Next
        ' collect garbage
        GC.Collect()
    End Sub
#End Region

#Region "Tunnel Abstraction Class"
    Public Class Tunnel
        ' tunnel abstraction object
#Region "Declares"
        Public Enum TunnelStatus As Long
            Down = 0
            Starting
            Started
            Connecting
            Connected
            Negotiating
            DeviceReady
            ListenUDP
            ListenTCP
            Up
            Closing
            Stopping
            [Error]
            Halted
            Disabled
            Restarting
        End Enum
#End Region

#Region "Private Vars"
        Private WithEvents _OpenVPNInstance As New OpenVPNCntrl
        Private _Halted As Boolean = False
        Private _Status As TunnelStatus
#End Region

#Region "Public Interface"
        Friend Property Parent As OpenVPNTunMgr
        Public Property HaltOnTUNTAPError As Boolean = True
        Public Property HaltOnPUSHTimeout As Boolean = True
        Public Property Disabled As Boolean
        Public Property Name As String

        Public ReadOnly Property Halted As Boolean
            Get
                Return _Halted
            End Get
        End Property

        Public ReadOnly Property Status As TunnelStatus
            Get
                Return _Status
            End Get
        End Property

        Public ReadOnly Property OpenVPNInstance() As OpenVPNCntrl
            ' return reference to openvpn process controller instance
            Get
                Return _OpenVPNInstance
            End Get
        End Property

        Public Sub Start()
            _Status = TunnelStatus.Starting
            WriteStatus()
            WriteRemoteHostPort("", 0)
            WriteTUNTAPInfo()
            ' start this tunnel if not disabled or halted
            If Disabled Then Exit Sub
            If Halted Then Exit Sub
            Log("Starting...", EventLogEntryType.Information)
            _OpenVPNInstance.Start()
        End Sub

        Public Sub [Stop]()
            ' stop this tunnel
            WriteRemoteHostPort("", 0)
            WriteTUNTAPInfo()
            If _OpenVPNInstance.Running Then
                _Status = TunnelStatus.Stopping
                WriteStatus()
                Log("Stopping...", EventLogEntryType.Information)
                _OpenVPNInstance.Stop()
            Else
                _Status = TunnelStatus.Down
                WriteStatus()
            End If
        End Sub

        Public Sub Reset()
            ' reset halt flag
            _Halted = False
        End Sub
#End Region

#Region "Internal Helper Functions"

        Private Sub Halt()
            ' stop this tunnel & set halt flag
            _Status = TunnelStatus.Halted
            _Halted = True
            Call _OpenVPNInstance.Stop()
            WriteStatus()
            WriteTUNTAPInfo()
        End Sub

        Private Sub Log(Message As String, EventType As EventLogEntryType)
            OpenVPNLogging.WLog("OpenVPNManager[" & Name & "]: " & Message, EventType)
        End Sub
        Private Sub Dbg(Message As String)
            OpenVPNLogging.WDbg("OpenVPNManager[" & Name & "]: " & Message)
        End Sub
#End Region

#Region "OpenVPN Instance Event Handling"
        Private Sub _OpenVPNInstance_OutputReceived(OutputLine As String) Handles _OpenVPNInstance.OutputReceived
            Dbg("# " & OutputLine)
        End Sub


        Private Sub _OpenVPNInstance_VPN_Config_Error(ErrorMessage As String) Handles _OpenVPNInstance.VPN_Config_Error
            ' HARD ERROR: Options / configuration error. Can't start
            _Status = TunnelStatus.Halted
            WriteStatus()
            WriteTUNTAPInfo()
            Log("Configuration error: " & ErrorMessage, EventLogEntryType.Error)
            Halt()
        End Sub

        Private Sub _OpenVPNInstance_VPN_DHCP_Configured(LocalIP As String, LocalNetmask As String, InterfaceGUID As System.Guid, DHCPServerIP As String, LeaseTime As UInteger) Handles _OpenVPNInstance.VPN_DHCP_Configured
            ' TUN/TAP configured via DHCP
            _Status = TunnelStatus.DeviceReady
            WriteStatus()
            WriteTUNTAPInfo(LocalIP, LocalNetmask, DHCPServerIP, InterfaceGUID.ToString)
            Dim IFName As String = NetHlp.GetAdapterDisplayNameByInterfaceID(InterfaceGUID)
            Log("TUN/TAP Interface [" & IFName & "] configured [IP=" & LocalIP & ", Netmask=" & LocalNetmask & ", DHCPServer=" & DHCPServerIP & ", LeaseTime=" & LeaseTime & "s].", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_DNS_Resolve_Failed(Hostname As String) Handles _OpenVPNInstance.VPN_DNS_Resolve_Failed
            ' ignore
        End Sub

        Private Sub _OpenVPNInstance_VPN_Down() Handles _OpenVPNInstance.VPN_Down
            _Status = TunnelStatus.Down
            WriteStatus()
            WriteRemoteHostPort("", 0)
            WriteTUNTAPInfo()
            Log("Tunnel Down.", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_PUSH_Timeout() Handles _OpenVPNInstance.VPN_PUSH_Timeout
            ' PUSH request timed out. CN blocked?
            If _HaltOnPUSHTimeout Then
                _Status = TunnelStatus.Halted
                Log("PUSH request(s) timed out. Halting tunnel...", EventLogEntryType.Error)
                Halt()
            Else
                _Status = TunnelStatus.Error
                Log("PUSH request(s) timed out.", EventLogEntryType.Error)
            End If
            WriteStatus()
        End Sub

        Private Sub _OpenVPNInstance_VPN_Restart() Handles _OpenVPNInstance.VPN_Restart
            _Status = TunnelStatus.Restarting
            WriteRemoteHostPort("", 0)
            WriteStatus()
            WriteTUNTAPInfo()
            Log("Tunnel restarting...", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_Restart_Watchdog() Handles _OpenVPNInstance.VPN_Restart_Watchdog
            _Status = TunnelStatus.Restarting
            WriteRemoteHostPort("", 0)
            WriteStatus()
            WriteTUNTAPInfo()
            Log("Watchdog triggered: Restarting tunnel...", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_Start() Handles _OpenVPNInstance.VPN_Start
            _Status = TunnelStatus.Started
            WriteRemoteHostPort("", 0)
            WriteStatus()
            Log("Started.", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_Stop() Handles _OpenVPNInstance.VPN_Stop
            _Status = TunnelStatus.Down
            WriteStatus()
            WriteRemoteHostPort("", 0)
            WriteTUNTAPInfo()
            Log("Stopped.", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TAP_Unavailable() Handles _OpenVPNInstance.VPN_TAP_Unavailable
            ' TUN/TAP device unavailable.
            If HaltOnTUNTAPError Then
                _Status = TunnelStatus.Halted
                Log("TUN/TAP device not available. Halting tunnel...", EventLogEntryType.Error)
                Halt()
            Else
                _Status = TunnelStatus.Error
                Log("TUN/TAP device not available.", EventLogEntryType.Error)
            End If
            WriteRemoteHostPort("", 0)
            WriteStatus()
        End Sub

        Private Sub _OpenVPNInstance_VPN_TCP_Connected(RemoteHost As String, RemotePort As Integer) Handles _OpenVPNInstance.VPN_TCP_Connected
            _Status = TunnelStatus.Connected
            WriteStatus()
            Log("TCP connected to [" & RemoteHost & ":" & RemotePort & "]", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TCP_Connecting(RemoteHost As String, RemotePort As Integer) Handles _OpenVPNInstance.VPN_TCP_Connecting
            _Status = TunnelStatus.Connecting
            WriteStatus()
            Log("TCP connecting to [" & RemoteHost & ":" & RemotePort & "]", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TCP_Listening(LocalHost As String, LocalPort As Integer) Handles _OpenVPNInstance.VPN_TCP_Listening
            _Status = TunnelStatus.ListenTCP
            WriteRemoteHostPort(LocalHost, LocalPort)
            WriteStatus()
            Log("TCP listening on [" & LocalHost & ":" & LocalPort & "]", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TCPUDP_Closing() Handles _OpenVPNInstance.VPN_TCPUDP_Closing
            _Status = TunnelStatus.Closing
            WriteStatus()
            WriteTUNTAPInfo()
            Log("TCP/UDP closing.", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TLS_Handshake_Begin(PeerIP As String, PeerPort As Integer) Handles _OpenVPNInstance.VPN_TLS_Handshake_Begin
            _Status = TunnelStatus.Negotiating
            WriteStatus()
            Log("Negotiating secure channel with [" & PeerIP & ":" & PeerPort & "]...", EventLogEntryType.Information)
            WriteRemoteHostPort(PeerIP, PeerPort)
        End Sub

        Private Sub _OpenVPNInstance_VPN_TLS_Handshake_Complete(PeerName As String) Handles _OpenVPNInstance.VPN_TLS_Handshake_Complete
            Log("Secure channel established. Remote: [" & PeerName & "].", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_UDP_Listening(LocalHost As String, LocalPort As Integer) Handles _OpenVPNInstance.VPN_UDP_Listening
            _Status = TunnelStatus.ListenUDP
            WriteRemoteHostPort(LocalHost, LocalPort)
            WriteStatus()
            Log("Tunnel listening on UDP [" & LocalHost & ":" & LocalPort & "].", EventLogEntryType.Information)
        End Sub

        Private Sub _OpenVPNInstance_VPN_Up(AdapterConfigured As Boolean, RoutesAdded As Boolean) Handles _OpenVPNInstance.VPN_Up
            _Status = TunnelStatus.Up
            WriteStatus()
            Log("Tunnel Up [TUNTAPConfig=" & CStr(IIf(AdapterConfigured, "OK", "FAILED")) & ", RoutingUpdate=" & CStr(IIf(RoutesAdded, "OK", "FAILED")) & "].", EventLogEntryType.Information)
        End Sub
#End Region

#Region "Status Reporting to Registry"

        Private Sub WriteStatus()
            Try
                ' obtain HKEY_LOCAL_MACHINE on both 32 and 64 bit systems
                Dim RegRoot As RegistryKey = WinReg.HKEY_LOCAL_MACHINE
                ' obtain tunnel root
                Dim TunRoot As RegistryKey = RegRoot.OpenSubKey(Reg_Tunnels_Root, True)
                If IsNothing(TunRoot) Then
                    ' tunnels root not found
                    Log("Configuration Registry key at [" & Reg_Tunnels_Root & "] not found.", EventLogEntryType.Error)
                Else
                    Dim TunnelRoot As RegistryKey = TunRoot.OpenSubKey(_Name, True)
                    Dim StatusReg As RegistryKey = TunnelRoot.OpenSubKey("Status", True)
                    StatusReg.SetValue("Status", _Status, RegistryValueKind.DWord)
                    StatusReg.Close()
                End If
            Catch ex As Exception
                Dbg("Unable to log status to registry: " & ex.Message)
            End Try

        End Sub

        Private Sub WriteRemoteHostPort(Host As String, Port As Integer)
            Try
                ' obtain HKEY_LOCAL_MACHINE on both 32 and 64 bit systems
                Dim RegRoot As RegistryKey = WinReg.HKEY_LOCAL_MACHINE
                ' obtain tunnel root
                Dim TunRoot As RegistryKey = RegRoot.OpenSubKey(Reg_Tunnels_Root, True)
                If IsNothing(TunRoot) Then
                    ' tunnels root not found
                    Log("Configuration Registry key at [" & Reg_Tunnels_Root & "] not found.", EventLogEntryType.Error)
                Else
                    Dim TunnelRoot As RegistryKey = TunRoot.OpenSubKey(_Name, True)
                    Dim StatusReg As RegistryKey = TunnelRoot.OpenSubKey("Status", True)
                    If Not Host = "" Then
                        StatusReg.SetValue("PeerIP", Host, RegistryValueKind.String)
                        StatusReg.SetValue("PeerPort", Port, RegistryValueKind.DWord)
                    Else
                        StatusReg.SetValue("PeerIP", "", RegistryValueKind.String)
                        StatusReg.SetValue("PeerPort", 0, RegistryValueKind.DWord)
                        StatusReg.Close()
                    End If
                End If
            Catch ex As Exception
                Dbg("Unable to log status to registry: " & ex.Message)
            End Try

        End Sub

        Private Sub WriteTUNTAPInfo(Optional LocalIP As String = "", Optional LocalNetmask As String = "", Optional DHCPServer As String = "", Optional InterfaceID As String = "")
            ' obtain HKEY_LOCAL_MACHINE on both 32 and 64 bit systems
            Dim RegRoot As RegistryKey = WinReg.HKEY_LOCAL_MACHINE
            ' obtain tunnel root
            Dim TunRoot As RegistryKey = RegRoot.OpenSubKey(Reg_Tunnels_Root, True)
            If IsNothing(TunRoot) Then
                ' tunnels root not found
                Log("Configuration Registry key at [" & Reg_Tunnels_Root & "] not found.", EventLogEntryType.Error)
            Else
                Try
                    ' write TUN/TAP status info
                    Dim TunnelRoot As RegistryKey = TunRoot.OpenSubKey(_Name, True)
                    Dim StatusReg As RegistryKey = TunnelRoot.OpenSubKey("Status", True)
                    StatusReg.SetValue("Interface ID", InterfaceID)
                    StatusReg.SetValue("IP Address", LocalIP, RegistryValueKind.String)
                    StatusReg.SetValue("Netmask", LocalNetmask, RegistryValueKind.String)
                    StatusReg.SetValue("DHCP Server", DHCPServer, RegistryValueKind.String)
                    StatusReg.Close()
                Catch ex As Exception
                    ' cant write status; ignore
                End Try
            End If
        End Sub
#End Region
    End Class
#End Region

#Region "Stale Process Handling"
        Public Sub KillAll(ProcName As String)
            ' kill all named processes
            For Each proc As Process In System.Diagnostics.Process.GetProcessesByName(ProcName)
                Try
                    proc.Kill()
                    proc.WaitForExit(3000)
                Catch ex As Exception
                    ' can't do anything about that now and we are shutting down anyways, so....ignore this one
                End Try
            Next
        End Sub
#End Region

#Region "Helper Functions"
        Function StripNumber(stdText As String) As String
            Dim str As String = "", i As Integer = 0, b As Integer = 1
            'strips the number from a longer text string
            stdText = Trim(stdText)
            For i = Len(stdText) To 1 Step -1
                If IsNumeric(Mid(stdText, i, 1)) Then
                    str = Left(stdText, Len(stdText) - b)
                    b = b + 1
                Else
                    Exit For
                End If
            Next i
            StripNumber = Trim(str)
        End Function


        Function GetTunnel(TunnelName As String) As Tunnel
            For Each Tun As Tunnel In _Tunnels
                If TunnelName.ToLower = Tun.Name.ToLower Then
                    Return Tun
                End If
            Next
            Throw New Exception("Tunnel [" & TunnelName & "] not found.")
        End Function

        Private Sub Log(Message As String, EventType As EventLogEntryType)
        OpenVPNLogging.WLog("OpenVPNManager: " & Message, EventType)
        End Sub
        Private Sub Dbg(Message As String)
        OpenVPNLogging.WDbg("OpenVPNManager: " & Message)
        End Sub


#End Region

#Region "Configuration Events"
        Private Sub Config_ConfigurationComplete() Handles Config.ConfigurationComplete
        Dim TunCount As Integer = 0
        If _Tunnels.Count > 0 Then
            ' start all tunnels that are not disabled
            For Each tun As Tunnel In _Tunnels
                If Not tun.Disabled Then
                    TunCount += 1
                    tun.Start()
                Else
                    ' dont start disabled tunnel. instead, write log entry
                    Log("Tunnel [" & tun.Name & "] is disabled. Not starting.", EventLogEntryType.Information)
                End If
            Next
            Dbg("Starting [" & TunCount & "] tunnels.")
        Else
            Log("No tunnels configured, nothing to start.", EventLogEntryType.Warning)
        End If
        End Sub

        Private Sub Config_ConfigurationNotFoundError() Handles Config.ConfigurationNotFoundError
        Log("OpenVPNManager: Configuration not found.", EventLogEntryType.Error)
        End Sub

        Private Sub Config_CreateTunnel(TunnelName As String) Handles Config.CreateTunnel
            Dim NewTunnel As Tunnel
            NewTunnel = New Tunnel
            NewTunnel.Parent = Me
            NewTunnel.Name = TunnelName
            _Tunnels.Add(NewTunnel)
        End Sub

        Private Sub Config_SetConfigLine(TunnelName As String, ConfigLine As String) Handles Config.SetConfigLine
            Dim Tun As Tunnel = GetTunnel(TunnelName)
            Tun.OpenVPNInstance.Configuration.Add(ConfigLine)
        End Sub

        Private Sub Config_SetDisable(TunnelName As String) Handles Config.SetDisable
            Dim Tun As Tunnel = GetTunnel(TunnelName)
            Tun.Disabled = True
        End Sub
#End Region


End Class

